home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2007 September / PCWSEP07.iso / Software / Linux / Linux Mint 3.0 Light / LinuxMint-3.0-Light.iso / casper / filesystem.squashfs / usr / share / apps / dcopidlng / Iter.pm < prev    next >
Encoding:
Perl POD Document  |  2005-09-10  |  11.2 KB  |  533 lines
  1. package Iter;
  2.  
  3. =head1 Iterator Module
  4.  
  5. A set of iterator functions for traversing the various trees and indexes.
  6. Each iterator expects closures that operate on the elements in the iterated
  7. data structure.
  8.  
  9.  
  10. =head2 Generic
  11.  
  12.     Params: $node, &$loopsub, &$skipsub, &$applysub, &$recursesub
  13.  
  14. Iterate over $node\'s children. For each iteration:
  15.     
  16. If loopsub( $node, $kid ) returns false, the loop is terminated.
  17. If skipsub( $node, $kid )  returns true, the element is skipped.
  18.  
  19. Applysub( $node, $kid ) is called
  20. If recursesub( $node, $kid ) returns true, the function recurses into
  21. the current node.
  22.  
  23. =cut
  24.  
  25. sub Generic
  26. {
  27.     my ( $root, $loopcond, $skipcond, $applysub, $recursecond ) = @_;
  28.  
  29.     return sub {
  30.         foreach my $node ( @{$root->{Kids}} ) {
  31.  
  32.             if ( defined  $loopcond ) {
  33.                 return 0 unless $loopcond->( $root, $node );
  34.             }
  35.  
  36.             if ( defined $skipcond ) {
  37.                 next if $skipcond->( $root, $node );
  38.             }
  39.  
  40.             my $ret = $applysub->( $root, $node );
  41.             return $ret if defined $ret && $ret;
  42.  
  43.             if ( defined $recursecond 
  44.                     && $recursecond->( $root, $node ) ) {
  45.                 $ret = Generic( $node, $loopcond, $skipcond,
  46.                         $applysub, $recursecond)->();
  47.                 if ( $ret ) {
  48.                     return $ret;
  49.                 }
  50.             }
  51.         }
  52.  
  53.         return 0;
  54.     };
  55. }
  56.  
  57. sub Class
  58. {
  59.     my ( $root, $applysub, $recurse ) = @_;
  60.  
  61.     return Generic( $root, undef,
  62.         sub {
  63.             return !( $node->{NodeType} eq "class" 
  64.                 || $node->{NodeType} eq "struct" );
  65.         }, 
  66.         $applysub, $recurse );
  67. }
  68.  
  69. =head2 Tree
  70.  
  71.     Params: $root, $recurse?, $commonsub, $compoundsub, $membersub,
  72.         $skipsub
  73.  
  74. Traverse the ast tree starting at $root, skipping if skipsub returns true.
  75.  
  76. Applying $commonsub( $node, $kid),
  77. then $compoundsub( $node, $kid ) or $membersub( $node, $kid ) depending on
  78. the Compound flag of the node.
  79.  
  80. =cut
  81.  
  82. sub Tree
  83. {
  84.     my ( $rootnode, $recurse, $commonsub, $compoundsub, $membersub, 
  85.          $skipsub ) = @_;
  86.  
  87.     my $recsub = $recurse ? sub { return 1 if $_[1]->{Compound}; } 
  88.                 : undef;
  89.  
  90.     Generic( $rootnode, undef, $skipsub,
  91.         sub {                     # apply
  92.             my ( $root, $node ) = @_;
  93.             my $ret;
  94.  
  95.             if ( defined $commonsub ) {
  96.                 $ret = $commonsub->( $root, $node );
  97.                 return $ret if defined $ret;
  98.             }
  99.  
  100.             if ( $node->{Compound} && defined $compoundsub ) {
  101.                 $ret = $compoundsub->( $root, $node );
  102.                 return $ret if defined $ret;
  103.             }
  104.             
  105.             if( !$node->{Compound} && defined $membersub ) {
  106.                 $ret = $membersub->( $root, $node );
  107.                 return $ret if defined $ret;
  108.             }
  109.             return;
  110.         },
  111.         $recsub                 # skip
  112.     )->();
  113. }
  114.  
  115. =head2 LocalCompounds
  116.  
  117. Apply $compoundsub( $node ) to all locally defined compound nodes
  118. (ie nodes that are not external to the library being processed).
  119.  
  120. =cut
  121.  
  122. sub LocalCompounds
  123. {
  124.         my ( $rootnode, $compoundsub ) = @_;
  125.  
  126.         return unless defined $rootnode && defined $rootnode->{Kids};
  127.  
  128.         foreach my $kid ( sort { $a->{astNodeName} cmp $b->{astNodeName} }
  129.                                  @{$rootnode->{Kids}} ) {
  130.                 next if !defined $kid->{Compound};
  131.  
  132.                 $compoundsub->( $kid ) unless defined $kid->{ExtSource};
  133.                 LocalCompounds( $kid, $compoundsub );
  134.         }
  135. }
  136.  
  137. =head2 Hierarchy
  138.  
  139.     Params: $node, $levelDownSub, $printSub, $levelUpSub
  140.  
  141. This allows easy hierarchy traversal and printing.
  142.  
  143. Traverses the inheritance hierarchy starting at $node, calling printsub
  144. for each node. When recursing downward into the tree, $levelDownSub($node) is
  145. called, the recursion takes place, and $levelUpSub is called when the
  146. recursion call is completed. 
  147.  
  148. =cut
  149.  
  150. sub Hierarchy
  151. {
  152.     my ( $node, $ldownsub, $printsub, $lupsub, $nokidssub ) = @_;
  153.  
  154.     return if defined $node->{ExtSource}
  155.         && (!defined $node->{InBy} 
  156.             || !kdocAstUtil::hasLocalInheritor( $node ));
  157.  
  158.     $printsub->( $node );
  159.  
  160.     if ( defined $node->{InBy} ) {
  161.         $ldownsub->( $node );
  162.  
  163.         foreach my $kid ( 
  164.                 sort {$a->{astNodeName} cmp $b->{astNodeName}}
  165.                 @{ $node->{InBy} } ) {
  166.             Hierarchy( $kid, $ldownsub, $printsub, $lupsub );
  167.         }
  168.  
  169.         $lupsub->( $node );
  170.     }
  171.     elsif ( defined $nokidssub ) {
  172.         $nokidssub->( $node );
  173.     }
  174.  
  175.     return;
  176. }
  177.  
  178. =head2
  179.  
  180.     Call $printsub for each *direct* ancestor of $node.
  181.     Only multiple inheritance can lead to $printsub being called more than once.
  182.  
  183. =cut
  184. sub Ancestors
  185. {
  186.     my ( $node, $rootnode, $noancessub, $startsub, $printsub,
  187.         $endsub ) = @_;
  188.     my @anlist = ();
  189.  
  190.     return if $node eq $rootnode;
  191.  
  192.     if ( !exists $node->{InList} ) {
  193.         $noancessub->( $node ) unless !defined $noancessub;
  194.         return;
  195.     }
  196.     
  197.     foreach my $innode ( @{ $node->{InList} } ) {
  198.         my $nref = $innode->{Node};    # real ancestor
  199.         next if defined $nref && $nref == $rootnode;
  200.  
  201.         push @anlist, $innode;
  202.     }
  203.  
  204.     if ( $#anlist < 0 ) {
  205.         $noancessub->( $node ) unless !defined $noancessub;
  206.         return;
  207.     }
  208.  
  209.     $startsub->( $node ) unless !defined $startsub;
  210.  
  211.     foreach my $innode ( sort { $a->{astNodeName} cmp $b->{astNodeName} }
  212.                 @anlist ) {
  213.  
  214.         # print
  215.         $printsub->( $innode->{Node}, $innode->{astNodeName},
  216.             $innode->{Type}, $innode->{TmplType} ) 
  217.             unless !defined $printsub;
  218.     }
  219.  
  220.     $endsub->( $node ) unless !defined $endsub;
  221.  
  222.     return;
  223.  
  224. }
  225.  
  226. sub Descendants
  227. {
  228.     my ( $node, $nodescsub, $startsub, $printsub, $endsub ) = @_;
  229.  
  230.     if ( !exists $node->{InBy} ) {
  231.         $nodescsub->( $node ) unless !defined $nodescsub;
  232.         return;
  233.     }
  234.  
  235.     
  236.     my @desclist = ();
  237.     DescendantList( \@desclist, $node );
  238.     
  239.     if ( $#desclist < 0 ) {
  240.         $nodescsub->( $node ) unless !defined $nodescsub;
  241.         return;
  242.     }
  243.  
  244.     $startsub->( $node ) unless !defined $startsub;
  245.  
  246.     foreach my $innode ( sort { $a->{astNodeName} cmp $b->{astNodeName} }
  247.                 @desclist ) {
  248.  
  249.         $printsub->( $innode) 
  250.             unless !defined $printsub;
  251.     }
  252.  
  253.     $endsub->( $node ) unless !defined $endsub;
  254.  
  255.     return;
  256.  
  257. }
  258.  
  259. sub DescendantList
  260. {
  261.     my ( $list, $node ) = @_;
  262.  
  263.     return unless exists $node->{InBy};
  264.  
  265.     foreach my $kid ( @{ $node->{InBy} } ) {
  266.         push @$list, $kid;
  267.         DescendantList( $list, $kid );
  268.     }
  269. }
  270.  
  271. =head2 DocTree
  272.  
  273. =cut
  274.  
  275. sub DocTree
  276. {
  277.     my ( $rootnode, $allowforward, $recurse, 
  278.         $commonsub, $compoundsub, $membersub ) = @_;
  279.         
  280.     Generic( $rootnode, undef,
  281.         sub {                # skip
  282.             my( $node, $kid ) = @_;
  283.  
  284.             unless (!(defined $kid->{ExtSource}) 
  285.                     && ($allowforward || $kid->{NodeType} ne "Forward")
  286.                     && ($main::doPrivate || !($kid->{Access} =~ /private/))
  287.                     && exists $kid->{DocNode} ) {
  288.  
  289.                 return 1;
  290.             }
  291.  
  292.             return;
  293.         },
  294.         sub {                 # apply
  295.             my ( $root, $node ) = @_;
  296.  
  297.             my $ret;
  298.  
  299.             if ( defined $commonsub ) {
  300.                 $ret = $commonsub->( $root, $node );
  301.                 return $ret if defined $ret;
  302.             }
  303.  
  304.             if ( $node->{Compound} && defined $compoundsub ) {
  305.                 $ret = $compoundsub->( $root, $node );
  306.                 return $ret if defined $ret;
  307.             }
  308.             elsif( defined $membersub ) {
  309.                 $ret = $membersub->( $root, $node );
  310.                 return $ret if defined $ret;
  311.             }
  312.  
  313.             return;
  314.         },
  315.         sub { return 1 if $recurse; return; }    # recurse
  316.         )->();
  317.  
  318. }
  319.  
  320. sub MembersByType
  321. {
  322.     my ( $node, $startgrpsub, $methodsub, $endgrpsub, $nokidssub ) = @_;
  323.  
  324. # public
  325.     # types
  326.     # data
  327.     # methods
  328.     # signals
  329.     # slots
  330.     # static
  331. # protected
  332. # private (if enabled)
  333.  
  334.     if ( !defined $node->{Kids} ) {
  335.             $nokidssub->( $node ) if defined $nokidssub;
  336.             return;
  337.     }
  338.  
  339.     foreach my $acc ( qw/public protected private/ ) {
  340.         next if $acc eq "private" && !$main::doPrivate;
  341.         $access = $acc;
  342.  
  343.         my @types = ();
  344.         my @data = ();
  345.         my @signals = ();
  346.         my @k_dcops = ();
  347.         my @k_dcop_signals = ();
  348.         my @k_dcop_hiddens = ();
  349.         my @slots =();
  350.         my @methods = ();
  351.         my @static = ();
  352.         my @modules = ();
  353.         my @interfaces = ();
  354.  
  355.         # Build lists
  356.         foreach my $kid ( @{$node->{Kids}} ) {
  357.             next unless ( $kid->{Access} =~ /$access/
  358.                       && !$kid->{ExtSource})
  359.                      || ( $access eq "public" 
  360.                     && ( $kid->{Access} eq "signals" 
  361.                       || $kid->{Access} =~ "k_dcop" # note the =~ 
  362.                   || $kid->{Access} eq "K_DCOP"));
  363.  
  364.             my $type = $kid->{NodeType};
  365.  
  366.             if ( $type eq "method" ) {
  367.                 if ( $kid->{Flags} =~ "s" ) {
  368.                     push @static, $kid;
  369.                 }
  370.                 elsif ( $kid->{Flags} =~ "l" ) {
  371.                     push @slots, $kid;
  372.                 }
  373.                 elsif ( $kid->{Flags} =~ "n" ) {
  374.                     push @signals, $kid;
  375.                 }
  376.                 elsif ( $kid->{Flags} =~ "d" ) {
  377.                     push @k_dcops, $kid;
  378.                 }
  379.                 elsif ( $kid->{Flags} =~ "z" ) {
  380.                     push @k_dcop_signals, $kid;
  381.                 }
  382.                 elsif ( $kid->{Flags} =~ "y" ) {
  383.                     push @k_dcop_hiddens, $kid;
  384.                 }
  385.                 else {
  386.                     push @methods, $kid; }
  387.             }
  388.             elsif ( $kid->{Compound} ) {
  389.                 if ( $type eq "module" ) {
  390.                     push @modules, $kid;
  391.                 }
  392.                 elsif ( $type eq "interface" ) {
  393.                     push @interfaces, $kid;
  394.                 }
  395.                 else {
  396.                     push @types, $kid;
  397.                 }
  398.             }
  399.             elsif ( $type eq "typedef" || $type eq "enum" ) {
  400.                 push @types, $kid;
  401.             }
  402.             else {
  403.                 push @data, $kid;
  404.             }
  405.         }
  406.  
  407.         # apply
  408.         $uc_access = ucfirst( $access );
  409.         
  410.         doGroup( "$uc_access Types", $node, \@types, $startgrpsub,
  411.             $methodsub, $endgrpsub);
  412.         doGroup( "Modules", $node, \@modules, $startgrpsub,
  413.             $methodsub, $endgrpsub);
  414.         doGroup( "Interfaces", $node, \@interfaces, $startgrpsub,
  415.             $methodsub, $endgrpsub);
  416.         doGroup( "$uc_access Methods", $node, \@methods, $startgrpsub,
  417.             $methodsub, $endgrpsub);
  418.         doGroup( "$uc_access Slots", $node, \@slots, $startgrpsub,
  419.             $methodsub, $endgrpsub);
  420.         doGroup( "Signals", $node, \@signals, $startgrpsub,
  421.             $methodsub, $endgrpsub);
  422.         doGroup( "k_dcop", $node, \@k_dcops, $startgrpsub,
  423.             $methodsub, $endgrpsub);
  424.         doGroup( "k_dcop_signals", $node, \@k_dcop_signals, $startgrpsub,
  425.             $methodsub, $endgrpsub);
  426.         doGroup( "k_dcop_hiddens", $node, \@k_dcop_hiddens, $startgrpsub,
  427.             $methodsub, $endgrpsub);
  428.         doGroup( "$uc_access Static Methods", $node, \@static, 
  429.             $startgrpsub, $methodsub, $endgrpsub);
  430.         doGroup( "$uc_access Members", $node, \@data, $startgrpsub,
  431.             $methodsub, $endgrpsub);
  432.     }
  433. }
  434.  
  435. sub doGroup
  436. {
  437.     my ( $name, $node, $list, $startgrpsub, $methodsub, $endgrpsub ) = @_;
  438.  
  439.         my ( $hasMembers ) = 0;
  440.         foreach my $kid ( @$list ) {
  441.                 if ( !exists $kid->{DocNode}->{Reimplemented} ) {
  442.                         $hasMembers = 1;
  443.                         break;
  444.                 }
  445.         }
  446.     return if !$hasMembers;
  447.     
  448.     if ( defined $methodsub ) {
  449.         foreach my $kid ( @$list ) {
  450.                         if ( !exists $kid->{DocNode}->{Reimplemented} ) {
  451.                          $methodsub->( $node, $kid );
  452.                         }
  453.         }
  454.     }
  455.  
  456.     $endgrpsub->( $name ) if defined $endgrpsub;
  457. }
  458.  
  459. sub ByGroupLogical
  460. {
  461.     my ( $root, $startgrpsub, $itemsub, $endgrpsub ) = @_;
  462.  
  463.     return 0 unless defined $root->{Groups};
  464.  
  465.     foreach my $groupname ( sort keys %{$root->{Groups}} ) {
  466.         next if $groupname eq "astNodeName"||$groupname eq "NodeType";
  467.  
  468.         my $group = $root->{Groups}->{ $group };
  469.         next unless $group->{Kids};
  470.         
  471.         $startgrpsub->( $group->{astNodeName}, $group->{Desc} );
  472.  
  473.         foreach my $kid (sort {$a->{astNodeName} cmp $b->{astNodeName}}
  474.                     @group->{Kids} ) {
  475.             $itemsub->( $root, $kid );
  476.         }
  477.         $endgrpsub->( $group->{Desc} );    
  478.     }
  479.  
  480.     return 1;
  481. }
  482.  
  483. sub SeeAlso
  484. {
  485.     my ( $node, $nonesub, $startsub, $printsub, $endsub ) = @_;
  486.  
  487.     if( !defined $node ) {
  488.         $nonesub->();
  489.         return;
  490.     }
  491.  
  492.     my $doc = $node;
  493.  
  494.     if ( $node->{NodeType} ne "DocNode" ) {
  495.         $doc = $node->{DocNode};
  496.         if ( !defined $doc ) {
  497.             $nonesub->() if defined $nonesub;
  498.             return;
  499.         }
  500.     }
  501.  
  502.     if ( !defined $doc->{See} ) {
  503.         $nonesub->() if defined $nonesub;
  504.         return;
  505.     }
  506.  
  507.     my $see = $doc->{See};
  508.     my $ref = $doc->{SeeRef};
  509.  
  510.     if ( $#$see < 1 ) {
  511.         $nonesub->() if defined $nonesub;
  512.         return;
  513.     }
  514.  
  515.     $startsub->( $node ) if defined $startsub;
  516.  
  517.     for my $i ( 0..$#$see ) {
  518.         my $seelabel = $see->[ $i ];
  519.         my $seenode = undef;
  520.         if ( defined $ref ) {
  521.             $seenode = $ref->[ $i ]; 
  522.         }
  523.  
  524.         $printsub->( $seelabel, $seenode ) if defined $printsub;
  525.     }
  526.  
  527.     $endsub->( $node ) if defined $endsub;
  528.  
  529.     return;
  530. }
  531.  
  532. 1;
  533.